 page
create jsr lookfile ;check for duplicate / get free entry
 bcs tstfnf ;error code in acc may be 'file not found'
 lda #duperr ;tell em a file of that name already exists
crerr1 sec ;indicate error encountered
 rts ;return error in acc.
*
tstfnf cmp #fnferr ;'file not found' is what we want
 bne crerr1 ;pass back other error.
 ldy #c.fkind ;test for "tree" or directory file.
 lda (par),y ;no other kinds are legal.
 cmp #$4 ;is it seed, sapling, or tree?
 bcc tstdspc  ;branch if it is.
 cmp #$d
 bne ctyperr ;report type error if not directory.
tstdspc lda devnum ;before proceeding, make sure destination device 
 jsr twrprot1 ; is not write protected...
 bcs crtn
 lda nofree ;is there space in directory to add this file?
 beq xtndir ;branch if not.
 jmp creat1 ;otherwise, go create file.
*
ctyperr lda #typerr
 sec ;indicate error
crtn rts
*
xtndir lda own.blok ;before extending directory,
 ora own.blok+1 ; make sure it is a sub directory!!!
 bne xtndir1
 lda #dirfull ;otherwise report directory full error.
 sec
 rts
*
xtndir1 lda bloknml ;preserve disk address of current (last)
 pha
 lda bloknmh ; directory link, before allocating an
 pha ; extend block.
 jsr alc1blk ;allocate a block for extending directory.
 tax ;save acc for now.
 pla
 sta bloknmh ;restore block addr of directory stuff in gbuf.
 pla
 sta bloknml
 txa ;restore acc.
 bcs crtn ;branch if unable to allocate.
 sta gbuf+2 ;save low block address in current directory
 sty gbuf+3 ;and hi adr too
 jsr wrtgbuf ;go update dir. block with new link.
 bcs crtn ;(report any errors.)
 ldx #1
swpbloks lda bloknml,x ;now prepare new directory block.
 sta gbuf,x ;use current block as back link.
 lda gbuf+2,x
 sta bloknml,x ;and save new block as next to be writen.
 dex
 bpl swpbloks
 inx ;now x=0
 txa ; and a=0 too.
clrdir sta gbuf+2,x
 sta gbuf+$100,x
 inx
 bne clrdir
 jsr wrtgbuf ;write prepared directory extention.
 bcs crtn ;report errors.
*
 lda own.blok
 ldx own.blok+1
 jsr rdblk ;read in 'parent' directory block. 
 ldx own.ent ;prepare to calculate entry address.
 lda #gbuf/256 
 sta drbufph
 lda #4
ocalc clc
 dex ;has entry adr. been computed
 beq ocalc1 ;branch if yes.
 adc own.len ;bump to next entry adr.
 bcc ocalc
 inc drbufph ;entry must be in second 256 of block.
 bcs ocalc ;branc always.
ocalc1 sta drbufpl
 ldy #d.usage ;index to block count.
ocalc2 lda (drbufpl),y
 adc dinctbl-d.usage,y ;add 1 to block count and 
 sta (drbufpl),y
 iny
 tya ; $200 to the directory's end of file. 
 eor #d.eof+3 ;done with usage/eof update? 
 bne ocalc2 ;branch if not. 
 jsr wrtgbuf ;go update parent.
 bcs crerr2
 jmp create
*
*
zgbuf lda #0 ;zero out gbuf.
 tax
clrgbuf sta gbuf,x
 sta gbuf+$100,x ;first zero out data block of file.
 inx
 bne clrgbuf ;loop until zipped!
crerr2 rts ;report errors...
*
creat1 equ *
 jsr zgbuf ;zero out gbuf.
 ldy #c.time+1 ;move user specified date/time
cmvtime lda (par),y ; to directory entry.
 sta dfil+d.credt-c.date,y
 txa ;if all four bytes of date/time are zero
 ora (par),y ; then use built in date/time.
 tax
 dey ;have all four bytes been moved and tested?
 cpy #c.fkind 
 bne cmvtime ;branch if not.
 txa ;does user want default time?
 bne cmvname ;branch if not.
 ldx #3
mvdftime lda datelo,x ;move current default date/time.
 sta dfil+d.credt,x
 dex
 bpl mvdftime
*
cmvname lda (par),y ;(y is pointing at fkind.)
 cmp #4
 lda #$10 ;assume tree type.
 bcc csvfkind
 lda #$d0 ;it is directory since file kind has already been verified.
csvfkind ldx namptr ;get index to 'local' name of pathname.
 ora pathbuf,x ;combine file kind with name length.
 sta dfil+d.stor ;(sos calls this 'storage type')
 and #$f ;strip back to name length.
 tay ;and use as count-down for move.
 clc
 adc namptr ;calculate end of name.
 tax
*
crname lda pathbuf,x ;now move local name as filename.
 sta dfil+d.stor,y
 dex
 dey ;all characters transfered?
 bne crname ;branch if not.
*
 ldy #c.attr ;index to 'access' parameter.
 lda (par),y
 sta dfil+d.attr
 iny ;also move 'file identification'
 lda (par),y
 sta dfil+d.filid
cmvauxid iny ; and finally, the auxillary identifcation bytes.
 lda (par),y
 sta dfil+d.auxid-c.auxid,y
 cpy #c.auxid+1 
 bne cmvauxid
 lda xdosver ;save current xdos version number.
 sta dfil+d.sosver
 lda compat ;and backward compatiblity number.
 sta dfil+d.comp
 lda #1 ;usage is always 1 block.
 sta dfil+d.usage
 lda d.head ;place back pointer to header block
 sta dfil+d.dhdr
 lda d.head+1
 sta dfil+d.dhdr+1
 lda dfil+d.stor ;get storage type again.
 and #$e0 ;is it a directory
 beq cralcblk ;branch if seed file.
 ldx #$1e ;move header to data block.
cmvheadr lda dfil+d.stor,x
 sta gbuf+4,x
 dex
 bpl cmvheadr
 eor #$30 ;($dn->$en) last one is fkind/namlen,
 sta gbuf+4 ; make it a directory header mark
 ldx #7 ;now overwrite password area and other header info.
cmvpass lda pass,x
 sta gbuf+4+$10,x
 lda xdosver,x
 sta gbuf+4+$1c,x
 dex
 bpl cmvpass
*
 ldx #2 ;and include info about 'parent directory.
 stx dfil+d.eof+1
cmvparnt lda d.entblk,x
 sta gbuf+4+$23,x
 dex
 bpl cmvparnt
 lda h.entln ;lastly the length of parent's dir entries
 sta gbuf+4+$26
*
cralcblk jsr alc1blk ;get address of file's data block.
 bcs crerr3 ;branch if error encountered.
 sta dfil+d.frst
 sty dfil+d.frst+1
 sta bloknml
 sty bloknmh
 jsr wrtgbuf ;go write data block of file.
 bcs crerr3
 inc h.fcnt ;add 1 to total # of files in this directory
 bne credone
 inc h.fcnt+1
credone jsr drevise ;go revise directories with new file. 
 bcs crerr3
 jmp upbmap ;lastly, update volume bitmap.
*
entcalc lda #gbuf/256 ;set high address of directory entry index pointer
 sta drbufph
 lda #4 ;calculate address of entry based
 ldx d.entnum ; on the entry number
ecalc0 clc
ecalc1 dex ;addr=gbuf+((entnum-1)*entlen)
 beq ecalc2
 adc h.entln
 bcc ecalc1
 inc drbufph ;bump hi address
 bcs ecalc0 ;branch always.
*
ecalc2 sta drbufpl ;save newly calculated low address
crerr3 equ * ;return errors
derror2 rts
 page 
drevise lda datelo ; if no clock,
 beq drevise1 ; then don't touch mod t/d
 ldx #3 ;move last modification date/time to entry being updated. 
modtime lda datelo,x
 sta dfil+d.moddt,x
 dex
 bpl modtime
*
drevise1 lda dfil+d.attr ; mark entry as backupable
 ora bkbitflg ; bit 5 = backup needed bit
 sta dfil+d.attr
 lda d.dev ;get device number of directory
 sta devnum ; to be revised.
 lda d.entblk ;and address of directory block
 ldx d.entblk+1
 jsr rdblk ;read block into general purpose buffer.
 bcs crerr3 
 jsr entcalc ;fix up pointer to entry location within gbuf.
 ldy h.entln ;now move 'd.' stuff to directory.
 dey
mvdent lda dfil+d.stor,y
 sta (drbufpl),y
 dey
 bpl mvdent
 lda d.head ;is the entry block the same as the
 cmp bloknml ; entry's header block?
 bne sventdir ;no, save entry block
 lda d.head+1 ;maybe, test high addresses
 cmp bloknmh
 beq uphead ;branch if they are the same block.
sventdir jsr wrtgbuf ;write updated directory block
 bcs derror2 ;return any error.
 lda d.head ;get address of header block
 ldx d.head+1
 jsr rdblk ;read in header block for modification
 bcs derror2 
uphead ldy #1 ;update current number of files in this directory 
uphed1 lda h.fcnt,y
 sta gbuf+hcent+4,y ;(current entry count)
 dey
 bpl uphed1
 lda h.attr ;also update header's attributes.
 sta gbuf+hattr+4
 jsr wrtgbuf ;go write updated header
 bcs derror1
 page
ripple lda gbuf+4 ;test for 'root' directory
 and #$f0 ; if it is root, then directory revision is complete.
 eor #$f0 ;(leaves carry clear)
 beq drvisdne ;branch if ripple done.
 lda gbuf+hrent+4 ;get entry number
 sta d.entnum
 lda gbuf+hreln+4 ; and the length of entries in that dir
 sta h.entln
 lda gbuf+hrblk+4 ;get addr of parent entry's dir block.
 ldx gbuf+hrblk+5
 jsr rdblk ;read that sucker in.
 bcs derror1
 jsr entcalc ;get indirect pointer to parent entry in gbuf
 lda datelo ; don't touch mod
 beq rupdate ; if no clock. . .
 ldx #3 ;now update the modification date and time for this entry too.
 ldy #d.moddt+3
riptime lda datelo,x
 sta (drbufpl),y
 dey
 dex
 bpl riptime ;move all for bytes...
rupdate jsr wrtgbuf ;write updated entry back to disk. (assumes bloknm undisturbedd)
 bcs derror1 ;give up on any error.
 ldy #d.dhdr ;now compare current block number to this
 lda (drbufpl),y ; entry's header block
 iny
 cmp bloknml ;are low addresses the same? 
 sta bloknml ;(save it in case it's not)
 bne ripple2 ;branch if entry does not reside in same block as header.
 lda (drbufpl),y ;check high address just to be sure.
 cmp bloknmh
 beq ripple ;they are the same, continue ripple to root directory.
ripple2 lda (drbufpl),y ;they aren't the same, read in this directory's header.
 sta bloknmh
 jsr rdgbuf
 bcc ripple ;continue if read was good.
derror1 equ *
 rts
 page
*
tsterr lda #notsos ;not tree or directory- not a recognized type!
 sec
 rts ;do nothing.
*
*
tstsos lda gbuf ;test sos stamp
 cmp sostmpl
 bne tsterr
 lda gbuf+1
 cmp sostmph
 bne tsterr
 lda gbuf+4 ;test for header
 and #$e0
 cmp #hedtyp*16
 bne tsterr ;branch if not sos header (no error number) 
drvisdne clc ;indicate no error./ 
 rts
*
